EnigmA Amiga Run 1997 April/EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso/EARCD/comm/bbs/Hydra11s.lha/HBBS/Source/Oberon/ANSIConsole.mod

Text File | 1996-07-02 | 6KB | 269 lines

MODULE ANSIConsole;

    TYPE
    WriteProc* = PROCEDURE(ch: CHAR);

    CONST
    stPlain* = 0;                stConcealed* = 8;
    stBold* = 1;                 stNonBold* = 22;
    stFaint* = 2;                stNonItalic* = 23;
    stItalic* = 3;               stNonUnderscore* = 24;
    stUnderscore* = 4;           stNonReversed* = 27;
    stReversed* = 5;             stNonConcealed* = 28;

    cForeBlack* = 30;            cBackBlack* = 40;
    cForeRed* = 31;              cBackRed* = 41;
    cForeGreen* = 32;            cBackGreen* = 42;
    cForeYellow* = 33;           cBackYellow* = 43;
    cForeBlue* = 34;             cBackBlue* = 44;
    cForePurple* = 35;           cBackPurple* = 45;
    cForeCyan* = 36;             cBackCyan* = 46;
    cForeWhite* = 37;            cBackWhite* = 47;
    cForeDefault* = 39;          cBackDefault* = 49;

    PROCEDURE WriteVal(w: WriteProc; val: INTEGER);
    VAR
        factor: INTEGER;
    BEGIN
    factor:= 1;
    WHILE factor < val DO factor:= factor * 10 END;
    LOOP
        w(CHR((val DIV factor) + 48));
        val:= val MOD factor;
        IF factor <= 1 THEN EXIT END;
        factor:= factor DIV 10;
    END;
    END WriteVal;

    PROCEDURE BELL* (w: WriteProc);
    BEGIN
    w(CHR(7H));
    END BELL;

    PROCEDURE BACKSPACE* (w: WriteProc);
    BEGIN
    w(CHR(8H));
    END BACKSPACE;

    PROCEDURE HTAB* (w: WriteProc);
    BEGIN
    w(CHR(9H));
    END HTAB;

    PROCEDURE LF* (w: WriteProc);
    BEGIN
    w(CHR(0AH));
    END LF;

    PROCEDURE VTAB* (w: WriteProc);
    BEGIN
    w(CHR(0BH));
    END VTAB;

    PROCEDURE FF* (w: WriteProc);
    BEGIN
    w(CHR(0CH));
    END FF;

    PROCEDURE CR* (w: WriteProc);
    BEGIN
    w(CHR(0DH));
    END CR;

    PROCEDURE SI* (w: WriteProc);
    BEGIN
    w(CHR(0EH));
    END SI;

    PROCEDURE SO* (w: WriteProc);
    BEGIN
    w(CHR(0FH));
    END SO;

    PROCEDURE ESC* (w: WriteProc);
    BEGIN
    w(CHR(1BH));
    END ESC;

    PROCEDURE INDEX* (w: WriteProc);
    BEGIN
    w(CHR(84H));
    END INDEX;

    PROCEDURE NextLine* (w: WriteProc);
    BEGIN
    w(CHR(85H));
    END NextLine;

    PROCEDURE SetHTabPos* (w: WriteProc);
    BEGIN
    w(CHR(88H));
    END SetHTabPos;

    PROCEDURE ReverseINDEX* (w: WriteProc);
    BEGIN
    w(CHR(8DH));
    END ReverseINDEX;

    PROCEDURE CSI* (w: WriteProc);
    BEGIN
    w(CHR(1BH)); w("[");
    END CSI;

    PROCEDURE RESET* (w: WriteProc);
    BEGIN
    ESC(w); w(CHR(63H));
    END RESET;

    PROCEDURE INSERT* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count >1 THEN WriteVal(w, count) END;
    w(CHR(40H));
    END INSERT;

    PROCEDURE UP* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(41H));
    END UP;

    PROCEDURE DOWN* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(42H));
    END DOWN;

    PROCEDURE RIGHT* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(43H));
    END RIGHT;

    PROCEDURE LEFT* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(44H));
    END LEFT;

    PROCEDURE CURSORNextLine* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(45H));
    END CURSORNextLine;

    PROCEDURE CURSORPrevLine* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(46H));
    END CURSORPrevLine;

    PROCEDURE CURSORGoTo* (w: WriteProc; row, column: INTEGER);
    BEGIN
    CSI(w);
    IF row > 1 THEN WriteVal(w, row) END;
    IF column > 1 THEN w(CHR(3BH)); WriteVal(w, column) END;
    w(CHR(48H));
    END CURSORGoTo;


    PROCEDURE GotoTAB* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(49H));
    END GotoTAB;

    PROCEDURE EraseToEOF* (w: WriteProc);
    BEGIN
    CSI(w); w(CHR(4AH));
    END EraseToEOF;

    PROCEDURE EraseToEOL* (w: WriteProc);
    BEGIN
    CSI(w); w(CHR(4BH));
    END EraseToEOL;

    PROCEDURE InsertLine* (w: WriteProc);
    BEGIN
    CSI(w); w(CHR(4CH));
    END InsertLine;

    PROCEDURE DeleteLine* (w: WriteProc);
    BEGIN
    CSI(w); w(CHR(4DH));
    END DeleteLine;

    PROCEDURE DeleteChars* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(50H));
    END DeleteChars;

    PROCEDURE ScrollUp* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(53H));
    END ScrollUp;

    PROCEDURE ScrollDown* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(54H));
    END ScrollDown;

    PROCEDURE CreateTab* (w: WriteProc);
    BEGIN
    CSI(w); WriteVal(w, 0); w(CHR(57H));
    END CreateTab;

    PROCEDURE ClearTab* (w: WriteProc);
    BEGIN
    CSI(w); WriteVal(w, 2); w(CHR(57H));
    END ClearTab;

    PROCEDURE ClearAllTabs* (w: WriteProc);
    BEGIN
    CSI(w); WriteVal(w, 5); w(CHR(57H));
    END ClearAllTabs;

    PROCEDURE GoToTABBackward* (w: WriteProc; count: INTEGER);
    BEGIN
    CSI(w);
    IF count > 1 THEN WriteVal(w, count) END;
    w(CHR(5AH));
    END GoToTABBackward;

    PROCEDURE SetLFMode* (w: WriteProc; dual: BOOLEAN);
    BEGIN
    CSI(w); w(CHR(32H)); w(CHR(30H));
    IF dual THEN w(CHR(68H)) ELSE w(CHR(6CH)) END;
    END SetLFMode;

    PROCEDURE ReportPos* (w: WriteProc);
    BEGIN
    CSI(w); w(CHR(36H)); w(CHR(6EH));
    END ReportPos;

    PROCEDURE SetStyle* (w: WriteProc; style: INTEGER);
    BEGIN
    CSI(w); WriteVal(w, style); w(CHR(6DH));
    END SetStyle;

    PROCEDURE SetColor* (w: WriteProc; color: INTEGER);
    BEGIN
    CSI(w); WriteVal(w, color); w(CHR(6DH));
    END SetColor;

END ANSIConsole.